home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DOS.SWG / 0006_Read Environment String.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-29  |  2KB  |  64 lines
  1. {$S-,R-,V-,I-,N-,B-,F-}
  2.  
  3. {$IFNDEF Ver40}
  4.   {Allow overlays}
  5.   {$F+,O-,X+,A-}
  6. {$ENDIF}
  7.  
  8. UNIT Self;
  9.  
  10. INTERFACE
  11.  
  12. FUNCTION GetSelf : STRING;
  13. FUNCTION GetSelfPath : STRING;
  14.  
  15. IMPLEMENTATION
  16.  
  17. FUNCTION GetSelf : STRING;
  18.  
  19.   VAR
  20.     Temp      : STRING;
  21.     I, EnvSeg  : WORD;
  22.   BEGIN
  23.     I      := 0;
  24.     Temp   := '';
  25.     EnvSeg := memw [prefixseg : $2C];  { have to set this up like any variable! }
  26.     WHILE memw [EnvSeg : I] <> 0 DO   { read through environment strings }
  27.       INC (I);
  28.     INC (I, 4);                      { jump around 2 null bytes & word count }
  29.     WHILE mem [EnvSeg : I] <> 0 DO    { skim off path & filename }
  30.       BEGIN
  31.         Temp := Temp + UPCASE (CHR (mem [EnvSeg : I]) );
  32.         INC (I);
  33.       END;
  34.     GetSelf := Temp;
  35. END; { function GetSelf }
  36.  
  37.  
  38. FUNCTION GetSelfPath : STRING;
  39.  
  40.   VAR
  41.     Temp      : STRING;
  42.     I, EnvSeg  : WORD;
  43.     Place     : INTEGER;
  44.   BEGIN
  45.     I   := 0;
  46.     Temp := '';
  47.     EnvSeg := memw [prefixseg : $2C];  { have to set this up like any variable! }
  48.     WHILE memw [EnvSeg : I] <> 0 DO   { read through environment strings }
  49.       INC (I);
  50.     INC (I, 4);                      { jump around 2 null bytes & word count }
  51.     WHILE mem [EnvSeg : I] <> 0 DO    { skim off path & filename }
  52.       BEGIN
  53.         Temp := Temp + UPCASE (CHR (mem [EnvSeg : I]) );
  54.         INC (I);
  55.       END;
  56.     Place := LENGTH (Temp);
  57.     WHILE (Place > 0) AND NOT (Temp [Place] IN [':', '\']) DO
  58.     Place := PRED (Place);
  59.     IF Place > 0 THEN Temp [0] := CHR (Place);
  60.     GetSelfPath := Temp;
  61. END; { function SelfPath }
  62.  
  63. END.
  64.